R Notebook to project
Итак, начну с загрузки пакетов. Их будет много.
Packages <- c("tidyverse", "tseries", "caret", "ggpubr", "stats", "corrplot", "GGally", "rstatix", "colorspace", "sandwich", "lmtest")
lapply(Packages, library, character.only = TRUE)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.6 v dplyr 1.0.8
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.1.2 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## lift## corrplot 0.92 loaded## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2##
## Attaching package: 'rstatix'## The following object is masked from 'package:stats':
##
## filter## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## [[1]]
## [1] "forcats" "stringr" "dplyr" "purrr" "readr" "tidyr"
## [7] "tibble" "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [13] "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "tseries" "forcats" "stringr" "dplyr" "purrr" "readr"
## [7] "tidyr" "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"
##
## [[3]]
## [1] "caret" "lattice" "tseries" "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [13] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [19] "base"
##
## [[4]]
## [1] "ggpubr" "caret" "lattice" "tseries" "forcats" "stringr"
## [7] "dplyr" "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [13] "tidyverse" "stats" "graphics" "grDevices" "utils" "datasets"
## [19] "methods" "base"
##
## [[5]]
## [1] "ggpubr" "caret" "lattice" "tseries" "forcats" "stringr"
## [7] "dplyr" "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [13] "tidyverse" "stats" "graphics" "grDevices" "utils" "datasets"
## [19] "methods" "base"
##
## [[6]]
## [1] "corrplot" "ggpubr" "caret" "lattice" "tseries" "forcats"
## [7] "stringr" "dplyr" "purrr" "readr" "tidyr" "tibble"
## [13] "ggplot2" "tidyverse" "stats" "graphics" "grDevices" "utils"
## [19] "datasets" "methods" "base"
##
## [[7]]
## [1] "GGally" "corrplot" "ggpubr" "caret" "lattice" "tseries"
## [7] "forcats" "stringr" "dplyr" "purrr" "readr" "tidyr"
## [13] "tibble" "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [19] "utils" "datasets" "methods" "base"
##
## [[8]]
## [1] "rstatix" "GGally" "corrplot" "ggpubr" "caret" "lattice"
## [7] "tseries" "forcats" "stringr" "dplyr" "purrr" "readr"
## [13] "tidyr" "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [19] "grDevices" "utils" "datasets" "methods" "base"
##
## [[9]]
## [1] "colorspace" "rstatix" "GGally" "corrplot" "ggpubr"
## [6] "caret" "lattice" "tseries" "forcats" "stringr"
## [11] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [16] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [21] "utils" "datasets" "methods" "base"
##
## [[10]]
## [1] "sandwich" "colorspace" "rstatix" "GGally" "corrplot"
## [6] "ggpubr" "caret" "lattice" "tseries" "forcats"
## [11] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [16] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [21] "grDevices" "utils" "datasets" "methods" "base"
##
## [[11]]
## [1] "lmtest" "zoo" "sandwich" "colorspace" "rstatix"
## [6] "GGally" "corrplot" "ggpubr" "caret" "lattice"
## [11] "tseries" "forcats" "stringr" "dplyr" "purrr"
## [16] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [21] "stats" "graphics" "grDevices" "utils" "datasets"
## [26] "methods" "base"А теперь и сам датасет. Это отзывы на винишко со всего мира. Датасет включает в себя страну, регион (как сам регион, так и аппеласьон), собсвенно отзыв, оценку по 100-балльной шкале, цену в долларах, имя сомелье и его твиттер. Во всех столбцах, кроме отзыва и оценки есть пропуски
wine <- read_csv('/Users/pitikov_egor/Desktop/winemag-data-130k-v2.csv')## New names:
## * `` -> ...1## Rows: 129971 Columns: 14
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (11): country, description, designation, province, region_1, region_2, t...
## dbl (3): ...1, points, price
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.wineПросто посмотреть зависимость всего от всего ничего не дало (исключены пункиы с огромным колечеством значений). Ну то есть дало понимание, что надо копать глубже…
wine_sub <- subset(wine, select = -c(1, description, designation, province, region_1, region_2, title, variety, winery, taster_twitter_handle))ggpairs(wine_sub, cardinality_threshold = 45, upper = list(continuous = wrap("cor", method = "spearman")))+
theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 4), axis.text.y = element_text(size = 4))## Warning: Removed 63 rows containing missing values (stat_boxplot).
## Removed 63 rows containing missing values (stat_boxplot).## Warning: Removed 8992 rows containing non-finite values (stat_boxplot).## Warning: Removed 63 rows containing non-finite values (stat_g_gally_count).## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
## Removed 8996 rows containing missing values## Warning in cor.test.default(x, y, method = method, use = use): Cannot compute
## exact p-value with ties## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 8996 rows containing non-finite values (stat_bin).## Warning: Removed 8996 rows containing missing values (geom_point).## Warning: Removed 8996 rows containing non-finite values (stat_density).## Warning: Removed 8996 rows containing non-finite values (stat_boxplot).## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 8996 rows containing non-finite values (stat_bin).
Для начала самое логичное - корреляция оценки и стоимости. Заметно, что данные скоррелированы, однако есть сильные выбросы. Да и стобалльное вино можно найти с 250 баксов, что не может не радовать. Однако линейную регрессию построить не получится - дисперсия на протяжении линии тренда различна. Возможно, это объясняется регионом производсва вина (брендовой накруткой стоимости)
as <- ggplot(wine, aes(x=price, y=points)) +
geom_point(aes(color = country)) +
stat_smooth(method = lm, se = T) +
ylim(75, 101) +
xlim(0, 1000)
ns <- ggplot(wine, aes(x=price, y=points)) +
geom_point(aes(color = country)) +
stat_smooth(method = lm, se = T) +
ylim(75, 101) +
ggtitle("Plot of points by price")
as## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 9010 rows containing non-finite values (stat_smooth).## Warning: Removed 9010 rows containing missing values (geom_point).## Warning: Removed 52 rows containing missing values (geom_smooth).
ns## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 8996 rows containing non-finite values (stat_smooth).## Warning: Removed 8996 rows containing missing values (geom_point).## Warning: Removed 69 rows containing missing values (geom_smooth).
Для проверки корреляции стоимости и рейтинга был применен тест спирмана. 0,6 довольно неплохая корреляция, а p-value указывает на ее значимость. Что ж, видимо, за хорошее вино надо платить.
a <- cor.test(wine$points, wine$price, method = 'spearman')## Warning in cor.test.default(wine$points, wine$price, method = "spearman"):
## Cannot compute exact p-value with tiesa##
## Spearman's rank correlation rho
##
## data: wine$points and wine$price
## S = 1.1632e+14, p-value < 2.2e-16
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.6057853Были построены гистограммы и функции распредения для оценок и стоимости. обе нормальными можно назвать с натяжкой, а значит, в дальнейшем в приоритете ранговые методы
g1 <- ggplot(wine, aes(price)) +
geom_histogram(aes(y = after_stat(density)),
position = 'identity') +
geom_density(bw = 8, alpha = 8) +
xlim(0, 200) +
ggtitle("Histogramm of price")
g2 <- ggplot(wine, aes(points)) +
geom_histogram(aes(y = after_stat(density), binwidth=0.5),
position = 'identity') +
geom_density(bw = 8, alpha = 8) +
xlim(70, 101) +
scale_x_continuous(breaks = seq(70, 101, by = 5)) +
ggtitle("Histogramm of scores")## Warning: Ignoring unknown aesthetics: binwidth## Scale for 'x' is already present. Adding another scale for 'x', which will
## replace the existing scale.#ggarrange(g1, g2 + rremove("x.text"),
# labels = c("A", "B"),
# ncol = 2, nrow = 1, vjust = 10, align = "v", widths = 1, heights = c(4, 4))
g1## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 9678 rows containing non-finite values (stat_bin).## Warning: Removed 9678 rows containing non-finite values (stat_density).## Warning: Removed 2 rows containing missing values (geom_bar).
g2## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Для проверки на нормальность был использован тест харки-бера. Даже он будет давать ошибки первого рода на таких данных, но чем богаты… Оба распредения значимо отличаются от нормального
x <- as.numeric(wine$points)
x <- x[!is.na(x)]
f <- jarque.bera.test(x)
f##
## Jarque Bera Test
##
## data: x
## X-squared = 520.15, df = 2, p-value < 2.2e-16y <- as.numeric(wine$price)
y <- x[!is.na(y)]
q <- jarque.bera.test(y)
q##
## Jarque Bera Test
##
## data: y
## X-squared = 460.29, df = 2, p-value < 2.2e-16Для оценки различий по стране-проихводителю был построен боксплот и посчитан тест круская уоллиса. Вина из разных стран значимо отличаются, в топе Чехия и Австрия.
ggplot(wine, aes(y=points, fill=country)) +
geom_boxplot()+
theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
ggtitle("Boxplot scores to country")
c <- wine %>% drop_na(country) %>% kruskal.test(points ~ country)## Warning in kruskal.test.default(., points ~ country): 'x' is a list, so ignoring
## argument 'g'## Warning in kruskal.test.default(., points ~ country): some elements of 'x' are
## not numeric and will be coerced to numericc##
## Kruskal-Wallis rank sum test
##
## data: .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16Так-так. Вроде как Чехия и Австрия в лидерах не только по производству пива, но и вина тоже. Чтобы проверить значимость различий между станами использован тест Данна. И тут выяснилось, что отличия у Чехии не особо значимы… Да и вообще хорошо отличаются только лидеры от аутсайдеров… Что ж, +- все вино из примерно топ-10 стран-прозводителей получило статистически неразличимые отличия и, кажется, чешское вино не стоит таких денег, как на полках в SimpleWine. (Стало грустно за потраченное…)
test_res <- wine %>% dunn_test(points ~ country, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 6), axis.text.y = element_text(size = 6), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals")
c <- wine %>% drop_na(country) %>% kruskal.test(points ~ country)## Warning in kruskal.test.default(., points ~ country): 'x' is a list, so ignoring
## argument 'g'## Warning in kruskal.test.default(., points ~ country): some elements of 'x' are
## not numeric and will be coerced to numericc##
## Kruskal-Wallis rank sum test
##
## data: .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16Чтобы выяснить ценовые предпочтения сомелье был также построен боксплот и проведен тест круская уоллиса. Сомелье пьют вино их разных ценовых категорий с очень большой значимостью. Это плохо, так как будет вносить дополнительный биас.
ggplot(wine, aes(y=price, x=taster_name, fill=taster_name)) +
geom_boxplot()+
theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
ylim(0, 250)+
ggtitle("Boxplot price to taster_name")## Warning: Removed 9450 rows containing non-finite values (stat_boxplot).
Чтобы проверить, кто именно из критиков от кого отличается использован тест Данна - он сохраняет ранжирование и использует дисперсионную оценку, полученную в тесте Краскелла Уолиса. Оп-ля. Оказывается, есть группы критиков, пьющие винишко из схожих ценовых категорий. Это хорошо, можно читать их отзывы и выбирать что-то прекрасно-фруктовое, приятно-танниновое, отметая откровенно плозие варианты. Или нет?
test_res <- wine %>% dunn_test(price ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals price of tasters")
c <- wine %>% drop_na(taster_name, price) %>% kruskal.test(price ~ taster_name)## Warning in kruskal.test.default(., price ~ taster_name): 'x' is a list, so
## ignoring argument 'g'## Warning in kruskal.test.default(., price ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numericc##
## Kruskal-Wallis rank sum test
##
## data: .
## Kruskal-Wallis chi-squared = 829175, df = 13, p-value < 2.2e-16Так. Есть понимание, что медианы различны. НО может между сомелье они похожи? Тест Данна может показать, где именно наблюдается различие
Следующим шагом стало создание боксплота оценок в зависимости от сомелье и проверка его тем же тестом круская. Оченки у критиков также разнятся, что вносит еще один биас.
ggplot(wine, aes(y=points, x=taster_name, fill=taster_name)) +
geom_boxplot()+
theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
ylim(70, 101)+
ggtitle("Boxplot score to taster_name")
c <- wine %>% drop_na(country) %>% kruskal.test(points ~ taster_name)## Warning in kruskal.test.default(., points ~ taster_name): 'x' is a list, so
## ignoring argument 'g'## Warning in kruskal.test.default(., points ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numericc##
## Kruskal-Wallis rank sum test
##
## data: .
## Kruskal-Wallis chi-squared = 1060085, df = 13, p-value < 2.2e-16ТАК. А может, все-таки есть просто группы критиков с похожей медианой оценки? Снова Данн и хитмап похож на хитмап по ценам! Да, все-таки у похожих ценовых диапазонов схожие оценки, за несколькими исключениями (Поль Грегут, например, перестает коррелировать с Кэрри Дайксом, хоть Дайкс и не теряет всех коррелций). Интересно… Однако в большинсве своем сомелье не нашли согласия - кажеся, цена роляет.
test_res <- wine %>% dunn_test(points ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals points of tasters")
Чтобы проверить, насколько сомелье привязаны к какой-либо стране, был проведен точный тест фишера. И да, величины страна-критик зависимы. А это еще один неучтенный биас…
wine %>% drop_na(taster_name, country) %>% group_by(taster_name, country) %>%summarise(count = n())## `summarise()` has grouped output by 'taster_name'. You can override using the
## `.groups` argument.wine_grouped <- wine %>% drop_na(taster_name, country) %>% group_by(taster_name, country) %>%summarise(count = n())%>% pivot_wider(names_from = taster_name, values_from = count)## `summarise()` has grouped output by 'taster_name'. You can override using the
## `.groups` argument.wine_grouped[is.na(wine_grouped)] <- 0## Warning in do.call("cbind", lapply(x, "is.na")): unable to translate 'Anne
## Krebiehl<U+00A0>MW' to native encoding## Warning in do.call("cbind", lapply(x, "is.na")): unable to translate 'Kerin
## O<U+2019>Keefe' to native encodingf.res <- fisher.test(wine_grouped[2:20], simulate.p.value = TRUE, B = 10000)
f.res##
## Fisher's Exact Test for Count Data with simulated p-value (based on
## 10000 replicates)
##
## data: wine_grouped[2:20]
## p-value = 9.999e-05
## alternative hypothesis: two.sidedДалее было посчитано число слов в каждом отзыве
wine$total <- sapply(wine$description, function(x) length(unlist(strsplit(as.character(x), "\\W+"))))
wineНа скаттерплоте отобрадена зависимость числа слов от оценки. Про любимое вино больше пишут - логично. А тест Спирмана нашел неплохую корреляцию между размером отзыва и оценкой.
as <- ggplot(wine, aes(x=total, y=points)) +
geom_point(aes(color = taster_name)) +
stat_smooth(method = lm, se = T) + ggtitle("Plot of points by total words")
as## `geom_smooth()` using formula 'y ~ x'
a <- cor.test(wine$points, wine$total, method = 'spearman')## Warning in cor.test.default(wine$points, wine$total, method = "spearman"):
## Cannot compute exact p-value with tiesa##
## Spearman's rank correlation rho
##
## data: wine$points and wine$total
## S = 1.8031e+14, p-value < 2.2e-16
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.5072382test_res <- wine %>% dunn_test(total ~ taster_name, p.adjust.method = "holm") %>% select(group1, group2, p.adj)
ggplot(test_res, aes(group1, group2)) + geom_tile(aes(fill = p.adj)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 6), axis.text.y = element_text(size = 6), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + ggtitle("Heatmap of Dunn pvals of total between somelje")
Далее было проверено, не отличаются ли по длине отзывы у разных сомелье. Отличаются, о чем говорит p-value теста Круская-Уоллиса
ggplot(wine, aes(y=total, x=taster_name, fill=taster_name)) +
geom_boxplot()+
theme(axis.text.x=element_text(angle =- 90, vjust = 0.5))+
ylim(0, 250)
c <- wine %>% drop_na(taster_name) %>% kruskal.test(total ~ taster_name)## Warning in kruskal.test.default(., total ~ taster_name): 'x' is a list, so
## ignoring argument 'g'## Warning in kruskal.test.default(., total ~ taster_name): some elements of 'x'
## are not numeric and will be coerced to numericc##
## Kruskal-Wallis rank sum test
##
## data: .
## Kruskal-Wallis chi-squared = 1034177, df = 14, p-value < 2.2e-16g1 <- ggplot(wine, aes(total)) +
geom_histogram(aes(y = after_stat(density)),
position = 'identity') +
geom_density(bw = 8, alpha = 8) +
xlim(0, 200) +
ggtitle("Histogramm of price")
g1## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 2 rows containing missing values (geom_bar).
x <- as.numeric(wine$total)
x <- x[!is.na(x)]
f <- jarque.bera.test(x)
f##
## Jarque Bera Test
##
## data: x
## X-squared = 16531, df = 2, p-value < 2.2e-16Была построена линейная регрессия оценки вина от числа слов в отзыве с учетом сомелье.Ибо распреления все-таки близки к нормальным, НО из-зи большого числа наблюдений чувствительность тестов многократно вохрастает. И она очень хорошо объясняет наблюдаемые зависимости. Кажется, что число слов в отзыве вообще один из самых лучших показателей хорошего вина - выбросы реже, чем по стоимости, стабильнее и так далее… На qq плоте звметно, что распредение остатков близко к нормальному. Из неприятного данные не совсем гомоскедаксичны, то есть доверительные интервалы для прогнозов надо считать довольно сложным образом мммм… тест Уайта или Голдфельда для ошибок. (Если присутсвует условная гетероскедаксичность, то есть и безусловная гомоскедаксичность - модель сохраняет силу! Объясняется это тем, что все пишут число слов близкое к среднему. И все-таки довольно редко (относительно) появляются отзывы в пару предоложений или “война и мир” на 100500 страниц (но читать интересно - я про отзывы на винишко). Ну, или можно немного поправить. Постараться.
Собственно, значимость коэффицентов приведена ниже. Нетрудно заметить, что это хороший предиктор не для всех сомелье, но для многих
total_to_points <- lm(points ~ total*taster_name, wine)
summary(total_to_points)##
## Call:
## lm(formula = points ~ total * taster_name, data = wine)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.7851 -1.6321 -0.0359 1.5946 10.8095
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 82.103821 0.376073 218.319 < 2e-16
## total 0.093711 0.008924 10.501 < 2e-16
## taster_nameAnna Lee C. Iijima 1.307893 0.418147 3.128 0.001761
## taster_nameAnne Krebiehl<U+00A0>MW 3.293674 0.397597 8.284 < 2e-16
## taster_nameCarrie Dykes 1.856185 1.027915 1.806 0.070956
## taster_nameChristina Pickard -7.098398 5.248603 -1.352 0.176239
## taster_nameFiona Adams 1.073617 2.212036 0.485 0.627427
## taster_nameJeff Jenssen 3.027258 0.594278 5.094 3.51e-07
## taster_nameJim Gordon -0.210811 0.404845 -0.521 0.602563
## taster_nameJoe Czerwinski 1.107008 0.399379 2.772 0.005575
## taster_nameKerin O<U+2019>Keefe 0.664343 0.390642 1.701 0.089013
## taster_nameLauren Buzzeo -1.285158 0.428298 -3.001 0.002695
## taster_nameMatt Kettmann 0.508493 0.413603 1.229 0.218916
## taster_nameMichael Schachner -2.530613 0.386700 -6.544 6.01e-11
## taster_nameMike DeSimone 3.613671 0.655955 5.509 3.62e-08
## taster_namePaul Gregutt 2.662007 0.385890 6.898 5.29e-12
## taster_nameRoger Voss 0.674660 0.380820 1.772 0.076464
## taster_nameSean P. Sullivan 2.830348 0.392619 7.209 5.68e-13
## taster_nameSusan Kostrzewa 2.322982 0.514182 4.518 6.25e-06
## taster_nameVirginie Boone 0.903723 0.387870 2.330 0.019810
## total:taster_nameAnna Lee C. Iijima 0.026245 0.009904 2.650 0.008052
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.015100 0.009291 1.625 0.104132
## total:taster_nameCarrie Dykes -0.037369 0.023394 -1.597 0.110184
## total:taster_nameChristina Pickard 0.246853 0.136834 1.804 0.071228
## total:taster_nameFiona Adams -0.011437 0.048066 -0.238 0.811917
## total:taster_nameJeff Jenssen -0.005446 0.015262 -0.357 0.721203
## total:taster_nameJim Gordon 0.070939 0.009604 7.386 1.52e-13
## total:taster_nameJoe Czerwinski 0.030473 0.009426 3.233 0.001226
## total:taster_nameKerin O<U+2019>Keefe 0.059629 0.009293 6.417 1.40e-10
## total:taster_nameLauren Buzzeo 0.047765 0.009792 4.878 1.07e-06
## total:taster_nameMatt Kettmann 0.056034 0.009561 5.861 4.62e-09
## total:taster_nameMichael Schachner 0.073514 0.009146 8.038 9.23e-16
## total:taster_nameMike DeSimone -0.020822 0.014439 -1.442 0.149298
## total:taster_namePaul Gregutt 0.002946 0.009115 0.323 0.746507
## total:taster_nameRoger Voss 0.060919 0.009051 6.731 1.70e-11
## total:taster_nameSean P. Sullivan 0.007387 0.009366 0.789 0.430292
## total:taster_nameSusan Kostrzewa -0.040420 0.012239 -3.303 0.000958
## total:taster_nameVirginie Boone 0.057080 0.009198 6.206 5.46e-10
##
## (Intercept) ***
## total ***
## taster_nameAnna Lee C. Iijima **
## taster_nameAnne Krebiehl<U+00A0>MW ***
## taster_nameCarrie Dykes .
## taster_nameChristina Pickard
## taster_nameFiona Adams
## taster_nameJeff Jenssen ***
## taster_nameJim Gordon
## taster_nameJoe Czerwinski **
## taster_nameKerin O<U+2019>Keefe .
## taster_nameLauren Buzzeo **
## taster_nameMatt Kettmann
## taster_nameMichael Schachner ***
## taster_nameMike DeSimone ***
## taster_namePaul Gregutt ***
## taster_nameRoger Voss .
## taster_nameSean P. Sullivan ***
## taster_nameSusan Kostrzewa ***
## taster_nameVirginie Boone *
## total:taster_nameAnna Lee C. Iijima **
## total:taster_nameAnne Krebiehl<U+00A0>MW
## total:taster_nameCarrie Dykes
## total:taster_nameChristina Pickard .
## total:taster_nameFiona Adams
## total:taster_nameJeff Jenssen
## total:taster_nameJim Gordon ***
## total:taster_nameJoe Czerwinski **
## total:taster_nameKerin O<U+2019>Keefe ***
## total:taster_nameLauren Buzzeo ***
## total:taster_nameMatt Kettmann ***
## total:taster_nameMichael Schachner ***
## total:taster_nameMike DeSimone
## total:taster_namePaul Gregutt
## total:taster_nameRoger Voss ***
## total:taster_nameSean P. Sullivan
## total:taster_nameSusan Kostrzewa ***
## total:taster_nameVirginie Boone ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.394 on 103689 degrees of freedom
## (26244 observations deleted due to missingness)
## Multiple R-squared: 0.3441, Adjusted R-squared: 0.3438
## F-statistic: 1470 on 37 and 103689 DF, p-value: < 2.2e-16plot(total_to_points, las = 1)
coeftest(total_to_points, vcov = vcovHC(total_to_points, type = 'HC3'))##
## t test of coefficients:
##
## Estimate Std. Error t value
## (Intercept) 82.1038206 0.2677962 306.5907
## total 0.0937110 0.0064376 14.5568
## taster_nameAnna Lee C. Iijima 1.3078927 0.3292439 3.9724
## taster_nameAnne Krebiehl<U+00A0>MW 3.2936742 0.2844301 11.5799
## taster_nameCarrie Dykes 1.8561851 0.8903608 2.0848
## taster_nameChristina Pickard -7.0983976 13.4983619 -0.5259
## taster_nameFiona Adams 1.0736169 1.4042502 0.7645
## taster_nameJeff Jenssen 3.0272584 0.4598497 6.5831
## taster_nameJim Gordon -0.2108106 0.2976978 -0.7081
## taster_nameJoe Czerwinski 1.1070085 0.3035456 3.6469
## taster_nameKerin O<U+2019>Keefe 0.6643432 0.2833427 2.3447
## taster_nameLauren Buzzeo -1.2851578 0.3020414 -4.2549
## taster_nameMatt Kettmann 0.5084926 0.3138658 1.6201
## taster_nameMichael Schachner -2.5306130 0.2857073 -8.8574
## taster_nameMike DeSimone 3.6136711 0.5310988 6.8041
## taster_namePaul Gregutt 2.6620068 0.2841107 9.3696
## taster_nameRoger Voss 0.6746601 0.2764124 2.4408
## taster_nameSean P. Sullivan 2.8303483 0.2851029 9.9275
## taster_nameSusan Kostrzewa 2.3229824 0.4601286 5.0486
## taster_nameVirginie Boone 0.9037228 0.2883349 3.1343
## total:taster_nameAnna Lee C. Iijima 0.0262449 0.0079512 3.3008
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.0151001 0.0067001 2.2537
## total:taster_nameCarrie Dykes -0.0373690 0.0210842 -1.7724
## total:taster_nameChristina Pickard 0.2468530 0.3484605 0.7084
## total:taster_nameFiona Adams -0.0114374 0.0318312 -0.3593
## total:taster_nameJeff Jenssen -0.0054462 0.0123327 -0.4416
## total:taster_nameJim Gordon 0.0709393 0.0071534 9.9169
## total:taster_nameJoe Czerwinski 0.0304729 0.0072150 4.2236
## total:taster_nameKerin O<U+2019>Keefe 0.0596292 0.0068802 8.6668
## total:taster_nameLauren Buzzeo 0.0477652 0.0070173 6.8068
## total:taster_nameMatt Kettmann 0.0560341 0.0072173 7.7639
## total:taster_nameMichael Schachner 0.0735145 0.0068403 10.7472
## total:taster_nameMike DeSimone -0.0208218 0.0116606 -1.7857
## total:taster_namePaul Gregutt 0.0029464 0.0067604 0.4358
## total:taster_nameRoger Voss 0.0609190 0.0066692 9.1344
## total:taster_nameSean P. Sullivan 0.0073870 0.0068862 1.0727
## total:taster_nameSusan Kostrzewa -0.0404203 0.0111988 -3.6094
## total:taster_nameVirginie Boone 0.0570801 0.0069268 8.2405
## Pr(>|t|)
## (Intercept) < 2.2e-16 ***
## total < 2.2e-16 ***
## taster_nameAnna Lee C. Iijima 7.120e-05 ***
## taster_nameAnne Krebiehl<U+00A0>MW < 2.2e-16 ***
## taster_nameCarrie Dykes 0.0370939 *
## taster_nameChristina Pickard 0.5989789
## taster_nameFiona Adams 0.4445424
## taster_nameJeff Jenssen 4.628e-11 ***
## taster_nameJim Gordon 0.4788622
## taster_nameJoe Czerwinski 0.0002655 ***
## taster_nameKerin O<U+2019>Keefe 0.0190462 *
## taster_nameLauren Buzzeo 2.093e-05 ***
## taster_nameMatt Kettmann 0.1052148
## taster_nameMichael Schachner < 2.2e-16 ***
## taster_nameMike DeSimone 1.022e-11 ***
## taster_namePaul Gregutt < 2.2e-16 ***
## taster_nameRoger Voss 0.0146575 *
## taster_nameSean P. Sullivan < 2.2e-16 ***
## taster_nameSusan Kostrzewa 4.459e-07 ***
## taster_nameVirginie Boone 0.0017232 **
## total:taster_nameAnna Lee C. Iijima 0.0009646 ***
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.0242176 *
## total:taster_nameCarrie Dykes 0.0763363 .
## total:taster_nameChristina Pickard 0.4786921
## total:taster_nameFiona Adams 0.7193603
## total:taster_nameJeff Jenssen 0.6587738
## total:taster_nameJim Gordon < 2.2e-16 ***
## total:taster_nameJoe Czerwinski 2.407e-05 ***
## total:taster_nameKerin O<U+2019>Keefe < 2.2e-16 ***
## total:taster_nameLauren Buzzeo 1.003e-11 ***
## total:taster_nameMatt Kettmann 8.310e-15 ***
## total:taster_nameMichael Schachner < 2.2e-16 ***
## total:taster_nameMike DeSimone 0.0741573 .
## total:taster_namePaul Gregutt 0.6629637
## total:taster_nameRoger Voss < 2.2e-16 ***
## total:taster_nameSean P. Sullivan 0.2833977
## total:taster_nameSusan Kostrzewa 0.0003071 ***
## total:taster_nameVirginie Boone < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Модель, учитывающая цену построилась ужасно - логично, распредение цены сильно отличается от нормального
total_to_points <- lm(points ~ (total + price)*taster_name, wine)
summary(total_to_points)##
## Call:
## lm(formula = points ~ (total + price) * taster_name, data = wine)
##
## Residuals:
## Min 1Q Median 3Q Max
## -42.900 -1.438 0.053 1.503 10.079
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 82.182511 0.360018 228.273 < 2e-16
## total 0.095353 0.008490 11.231 < 2e-16
## price -0.005012 0.006778 -0.739 0.459670
## taster_nameAnna Lee C. Iijima 1.432122 0.397370 3.604 0.000314
## taster_nameAnne Krebiehl<U+00A0>MW 3.125998 0.380801 8.209 2.26e-16
## taster_nameCarrie Dykes 0.456624 1.068226 0.427 0.669045
## taster_nameChristina Pickard -9.817506 4.932786 -1.990 0.046566
## taster_nameFiona Adams 0.800761 2.197100 0.364 0.715513
## taster_nameJeff Jenssen 3.052657 0.554301 5.507 3.65e-08
## taster_nameJim Gordon -0.260986 0.385304 -0.677 0.498184
## taster_nameJoe Czerwinski 1.258999 0.381153 3.303 0.000956
## taster_nameKerin O<U+2019>Keefe 0.904663 0.374092 2.418 0.015596
## taster_nameLauren Buzzeo -1.199472 0.421306 -2.847 0.004414
## taster_nameMatt Kettmann 0.343655 0.393705 0.873 0.382733
## taster_nameMichael Schachner -1.840234 0.369713 -4.977 6.45e-07
## taster_nameMike DeSimone 3.318037 0.615622 5.390 7.07e-08
## taster_namePaul Gregutt 1.599696 0.369224 4.333 1.48e-05
## taster_nameRoger Voss 0.142443 0.365469 0.390 0.696718
## taster_nameSean P. Sullivan 2.260183 0.374942 6.028 1.67e-09
## taster_nameSusan Kostrzewa 2.137625 0.485700 4.401 1.08e-05
## taster_nameVirginie Boone 0.414816 0.370532 1.120 0.262924
## total:taster_nameAnna Lee C. Iijima 0.004685 0.009397 0.499 0.618101
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.003948 0.008896 0.444 0.657147
## total:taster_nameCarrie Dykes -0.040675 0.021573 -1.885 0.059368
## total:taster_nameChristina Pickard 0.143537 0.132386 1.084 0.278268
## total:taster_nameFiona Adams -0.012993 0.044066 -0.295 0.768104
## total:taster_nameJeff Jenssen -0.031796 0.014514 -2.191 0.028470
## total:taster_nameJim Gordon 0.034901 0.009204 3.792 0.000149
## total:taster_nameJoe Czerwinski 0.004050 0.008980 0.451 0.651985
## total:taster_nameKerin O<U+2019>Keefe 0.030812 0.008893 3.465 0.000531
## total:taster_nameLauren Buzzeo 0.031243 0.009905 3.154 0.001609
## total:taster_nameMatt Kettmann 0.042819 0.009077 4.718 2.39e-06
## total:taster_nameMichael Schachner 0.033724 0.008718 3.868 0.000110
## total:taster_nameMike DeSimone -0.034570 0.013731 -2.518 0.011813
## total:taster_namePaul Gregutt -0.021680 0.008672 -2.500 0.012425
## total:taster_nameRoger Voss 0.052950 0.008639 6.129 8.87e-10
## total:taster_nameSean P. Sullivan -0.031864 0.008959 -3.557 0.000376
## total:taster_nameSusan Kostrzewa -0.055160 0.011621 -4.747 2.07e-06
## total:taster_nameVirginie Boone 0.032243 0.008751 3.685 0.000229
## price:taster_nameAnna Lee C. Iijima 0.025783 0.006830 3.775 0.000160
## price:taster_nameAnne Krebiehl<U+00A0>MW 0.022288 0.006965 3.200 0.001375
## price:taster_nameCarrie Dykes 0.049868 0.018531 2.691 0.007122
## price:taster_nameChristina Pickard 0.225585 0.093014 2.425 0.015299
## price:taster_nameFiona Adams 0.011120 0.027454 0.405 0.685450
## price:taster_nameJeff Jenssen 0.040476 0.008168 4.955 7.23e-07
## price:taster_nameJim Gordon 0.056144 0.007103 7.905 2.71e-15
## price:taster_nameJoe Czerwinski 0.028734 0.006817 4.215 2.50e-05
## price:taster_nameKerin O<U+2019>Keefe 0.023897 0.006806 3.511 0.000446
## price:taster_nameLauren Buzzeo 0.027906 0.007365 3.789 0.000151
## price:taster_nameMatt Kettmann 0.022448 0.006835 3.284 0.001023
## price:taster_nameMichael Schachner 0.040887 0.006811 6.003 1.95e-09
## price:taster_nameMike DeSimone 0.032525 0.009088 3.579 0.000345
## price:taster_namePaul Gregutt 0.064855 0.006889 9.414 < 2e-16
## price:taster_nameRoger Voss 0.017889 0.006782 2.638 0.008347
## price:taster_nameSean P. Sullivan 0.061129 0.006989 8.746 < 2e-16
## price:taster_nameSusan Kostrzewa 0.033631 0.007844 4.288 1.81e-05
## price:taster_nameVirginie Boone 0.034319 0.006816 5.035 4.78e-07
##
## (Intercept) ***
## total ***
## price
## taster_nameAnna Lee C. Iijima ***
## taster_nameAnne Krebiehl<U+00A0>MW ***
## taster_nameCarrie Dykes
## taster_nameChristina Pickard *
## taster_nameFiona Adams
## taster_nameJeff Jenssen ***
## taster_nameJim Gordon
## taster_nameJoe Czerwinski ***
## taster_nameKerin O<U+2019>Keefe *
## taster_nameLauren Buzzeo **
## taster_nameMatt Kettmann
## taster_nameMichael Schachner ***
## taster_nameMike DeSimone ***
## taster_namePaul Gregutt ***
## taster_nameRoger Voss
## taster_nameSean P. Sullivan ***
## taster_nameSusan Kostrzewa ***
## taster_nameVirginie Boone
## total:taster_nameAnna Lee C. Iijima
## total:taster_nameAnne Krebiehl<U+00A0>MW
## total:taster_nameCarrie Dykes .
## total:taster_nameChristina Pickard
## total:taster_nameFiona Adams
## total:taster_nameJeff Jenssen *
## total:taster_nameJim Gordon ***
## total:taster_nameJoe Czerwinski
## total:taster_nameKerin O<U+2019>Keefe ***
## total:taster_nameLauren Buzzeo **
## total:taster_nameMatt Kettmann ***
## total:taster_nameMichael Schachner ***
## total:taster_nameMike DeSimone *
## total:taster_namePaul Gregutt *
## total:taster_nameRoger Voss ***
## total:taster_nameSean P. Sullivan ***
## total:taster_nameSusan Kostrzewa ***
## total:taster_nameVirginie Boone ***
## price:taster_nameAnna Lee C. Iijima ***
## price:taster_nameAnne Krebiehl<U+00A0>MW **
## price:taster_nameCarrie Dykes **
## price:taster_nameChristina Pickard *
## price:taster_nameFiona Adams
## price:taster_nameJeff Jenssen ***
## price:taster_nameJim Gordon ***
## price:taster_nameJoe Czerwinski ***
## price:taster_nameKerin O<U+2019>Keefe ***
## price:taster_nameLauren Buzzeo ***
## price:taster_nameMatt Kettmann **
## price:taster_nameMichael Schachner ***
## price:taster_nameMike DeSimone ***
## price:taster_namePaul Gregutt ***
## price:taster_nameRoger Voss **
## price:taster_nameSean P. Sullivan ***
## price:taster_nameSusan Kostrzewa ***
## price:taster_nameVirginie Boone ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.191 on 96422 degrees of freedom
## (33492 observations deleted due to missingness)
## Multiple R-squared: 0.449, Adjusted R-squared: 0.4487
## F-statistic: 1403 on 56 and 96422 DF, p-value: < 2.2e-16plot(total_to_points, las = 1)
coeftest(total_to_points, vcov = vcovHC(total_to_points, type = 'HC3'))##
## t test of coefficients:
##
## Estimate Std. Error t value
## (Intercept) 82.1825105 0.2859171 287.4348
## total 0.0953532 0.0064002 14.8985
## price -0.0050119 0.0050147 -0.9994
## taster_nameAnna Lee C. Iijima 1.4321216 0.3378524 4.2389
## taster_nameAnne Krebiehl<U+00A0>MW 3.1259981 0.3204131 9.7561
## taster_nameCarrie Dykes 0.4566241 0.9845022 0.4638
## taster_nameChristina Pickard -9.8175063 5.1696952 -1.8990
## taster_nameFiona Adams 0.8007612 1.6864911 0.4748
## taster_nameJeff Jenssen 3.0526569 0.4516318 6.7592
## taster_nameJim Gordon -0.2609863 0.3112134 -0.8386
## taster_nameJoe Czerwinski 1.2589987 0.3181000 3.9579
## taster_nameKerin O<U+2019>Keefe 0.9046631 0.3005018 3.0105
## taster_nameLauren Buzzeo -1.1994717 0.3294817 -3.6405
## taster_nameMatt Kettmann 0.3436550 0.3888270 0.8838
## taster_nameMichael Schachner -1.8402337 0.3028656 -6.0761
## taster_nameMike DeSimone 3.3180368 0.5647031 5.8757
## taster_namePaul Gregutt 1.5996959 0.3011177 5.3125
## taster_nameRoger Voss 0.1424434 0.2963021 0.4807
## taster_nameSean P. Sullivan 2.2601832 0.3013580 7.5000
## taster_nameSusan Kostrzewa 2.1376248 0.5520283 3.8723
## taster_nameVirginie Boone 0.4148158 0.3035462 1.3666
## total:taster_nameAnna Lee C. Iijima 0.0046847 0.0078668 0.5955
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.0039484 0.0151395 0.2608
## total:taster_nameCarrie Dykes -0.0406752 0.0205276 -1.9815
## total:taster_nameChristina Pickard 0.1435366 0.1332173 1.0775
## total:taster_nameFiona Adams -0.0129930 0.0336584 -0.3860
## total:taster_nameJeff Jenssen -0.0317962 0.0116844 -2.7213
## total:taster_nameJim Gordon 0.0349014 0.0072149 4.8374
## total:taster_nameJoe Czerwinski 0.0040503 0.0073802 0.5488
## total:taster_nameKerin O<U+2019>Keefe 0.0308118 0.0069434 4.4376
## total:taster_nameLauren Buzzeo 0.0312425 0.0077630 4.0246
## total:taster_nameMatt Kettmann 0.0428195 0.0187961 2.2781
## total:taster_nameMichael Schachner 0.0337238 0.0070810 4.7626
## total:taster_nameMike DeSimone -0.0345703 0.0118002 -2.9296
## total:taster_namePaul Gregutt -0.0216797 0.0066895 -3.2409
## total:taster_nameRoger Voss 0.0529505 0.0072073 7.3468
## total:taster_nameSean P. Sullivan -0.0318642 0.0068794 -4.6318
## total:taster_nameSusan Kostrzewa -0.0551597 0.0110395 -4.9966
## total:taster_nameVirginie Boone 0.0322430 0.0068941 4.6769
## price:taster_nameAnna Lee C. Iijima 0.0257826 0.0057106 4.5149
## price:taster_nameAnne Krebiehl<U+00A0>MW 0.0222880 0.0252428 0.8829
## price:taster_nameCarrie Dykes 0.0498685 0.0154147 3.2351
## price:taster_nameChristina Pickard 0.2255851 0.1123785 2.0074
## price:taster_nameFiona Adams 0.0111200 0.0189444 0.5870
## price:taster_nameJeff Jenssen 0.0404757 0.0113007 3.5817
## price:taster_nameJim Gordon 0.0561439 0.0057655 9.7379
## price:taster_nameJoe Czerwinski 0.0287345 0.0056349 5.0993
## price:taster_nameKerin O<U+2019>Keefe 0.0238966 0.0051647 4.6269
## price:taster_nameLauren Buzzeo 0.0279062 0.0076083 3.6679
## price:taster_nameMatt Kettmann 0.0224478 0.0285103 0.7874
## price:taster_nameMichael Schachner 0.0408871 0.0056327 7.2589
## price:taster_nameMike DeSimone 0.0325253 0.0079891 4.0712
## price:taster_namePaul Gregutt 0.0648550 0.0053154 12.2014
## price:taster_nameRoger Voss 0.0178892 0.0054163 3.3029
## price:taster_nameSean P. Sullivan 0.0611291 0.0053678 11.3881
## price:taster_nameSusan Kostrzewa 0.0336306 0.0157142 2.1401
## price:taster_nameVirginie Boone 0.0343189 0.0051770 6.6292
## Pr(>|t|)
## (Intercept) < 2.2e-16 ***
## total < 2.2e-16 ***
## price 0.3175826
## taster_nameAnna Lee C. Iijima 2.248e-05 ***
## taster_nameAnne Krebiehl<U+00A0>MW < 2.2e-16 ***
## taster_nameCarrie Dykes 0.6427834
## taster_nameChristina Pickard 0.0575610 .
## taster_nameFiona Adams 0.6349242
## taster_nameJeff Jenssen 1.396e-11 ***
## taster_nameJim Gordon 0.4016909
## taster_nameJoe Czerwinski 7.567e-05 ***
## taster_nameKerin O<U+2019>Keefe 0.0026088 **
## taster_nameLauren Buzzeo 0.0002723 ***
## taster_nameMatt Kettmann 0.3767929
## taster_nameMichael Schachner 1.236e-09 ***
## taster_nameMike DeSimone 4.224e-09 ***
## taster_namePaul Gregutt 1.084e-07 ***
## taster_nameRoger Voss 0.6307045
## taster_nameSean P. Sullivan 6.436e-14 ***
## taster_nameSusan Kostrzewa 0.0001079 ***
## taster_nameVirginie Boone 0.1717647
## total:taster_nameAnna Lee C. Iijima 0.5515085
## total:taster_nameAnne Krebiehl<U+00A0>MW 0.7942444
## total:taster_nameCarrie Dykes 0.0475395 *
## total:taster_nameChristina Pickard 0.2812767
## total:taster_nameFiona Adams 0.6994779
## total:taster_nameJeff Jenssen 0.0065045 **
## total:taster_nameJim Gordon 1.318e-06 ***
## total:taster_nameJoe Czerwinski 0.5831415
## total:taster_nameKerin O<U+2019>Keefe 9.108e-06 ***
## total:taster_nameLauren Buzzeo 5.712e-05 ***
## total:taster_nameMatt Kettmann 0.0227228 *
## total:taster_nameMichael Schachner 1.914e-06 ***
## total:taster_nameMike DeSimone 0.0033943 **
## total:taster_namePaul Gregutt 0.0011921 **
## total:taster_nameRoger Voss 2.047e-13 ***
## total:taster_nameSean P. Sullivan 3.629e-06 ***
## total:taster_nameSusan Kostrzewa 5.846e-07 ***
## total:taster_nameVirginie Boone 2.916e-06 ***
## price:taster_nameAnna Lee C. Iijima 6.343e-06 ***
## price:taster_nameAnne Krebiehl<U+00A0>MW 0.3772684
## price:taster_nameCarrie Dykes 0.0012163 **
## price:taster_nameChristina Pickard 0.0447131 *
## price:taster_nameFiona Adams 0.5572162
## price:taster_nameJeff Jenssen 0.0003416 ***
## price:taster_nameJim Gordon < 2.2e-16 ***
## price:taster_nameJoe Czerwinski 3.415e-07 ***
## price:taster_nameKerin O<U+2019>Keefe 3.717e-06 ***
## price:taster_nameLauren Buzzeo 0.0002447 ***
## price:taster_nameMatt Kettmann 0.4310739
## price:taster_nameMichael Schachner 3.931e-13 ***
## price:taster_nameMike DeSimone 4.681e-05 ***
## price:taster_namePaul Gregutt < 2.2e-16 ***
## price:taster_nameRoger Voss 0.0009574 ***
## price:taster_nameSean P. Sullivan < 2.2e-16 ***
## price:taster_nameSusan Kostrzewa 0.0323462 *
## price:taster_nameVirginie Boone 3.394e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1После этого я решил пропробовать что-то сказать про текст отзыва, для чего импортируется еще куча библиотек
libs <- c('tidytext', 'stringr', 'tidyr', 'wordcloud', 'reshape2', 'hunspell','SnowballC', 'xtable', 'knitr', 'kableExtra')
lapply(libs, library, character.only = TRUE)## Loading required package: RColorBrewer##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smiths##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rows## [[1]]
## [1] "tidytext" "lmtest" "zoo" "sandwich" "colorspace"
## [6] "rstatix" "GGally" "corrplot" "ggpubr" "caret"
## [11] "lattice" "tseries" "forcats" "stringr" "dplyr"
## [16] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [21] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [26] "datasets" "methods" "base"
##
## [[2]]
## [1] "tidytext" "lmtest" "zoo" "sandwich" "colorspace"
## [6] "rstatix" "GGally" "corrplot" "ggpubr" "caret"
## [11] "lattice" "tseries" "forcats" "stringr" "dplyr"
## [16] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [21] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [26] "datasets" "methods" "base"
##
## [[3]]
## [1] "tidytext" "lmtest" "zoo" "sandwich" "colorspace"
## [6] "rstatix" "GGally" "corrplot" "ggpubr" "caret"
## [11] "lattice" "tseries" "forcats" "stringr" "dplyr"
## [16] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [21] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [26] "datasets" "methods" "base"
##
## [[4]]
## [1] "wordcloud" "RColorBrewer" "tidytext" "lmtest" "zoo"
## [6] "sandwich" "colorspace" "rstatix" "GGally" "corrplot"
## [11] "ggpubr" "caret" "lattice" "tseries" "forcats"
## [16] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [21] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [26] "grDevices" "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "reshape2" "wordcloud" "RColorBrewer" "tidytext" "lmtest"
## [6] "zoo" "sandwich" "colorspace" "rstatix" "GGally"
## [11] "corrplot" "ggpubr" "caret" "lattice" "tseries"
## [16] "forcats" "stringr" "dplyr" "purrr" "readr"
## [21] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [26] "graphics" "grDevices" "utils" "datasets" "methods"
## [31] "base"
##
## [[6]]
## [1] "hunspell" "reshape2" "wordcloud" "RColorBrewer" "tidytext"
## [6] "lmtest" "zoo" "sandwich" "colorspace" "rstatix"
## [11] "GGally" "corrplot" "ggpubr" "caret" "lattice"
## [16] "tseries" "forcats" "stringr" "dplyr" "purrr"
## [21] "readr" "tidyr" "tibble" "ggplot2" "tidyverse"
## [26] "stats" "graphics" "grDevices" "utils" "datasets"
## [31] "methods" "base"
##
## [[7]]
## [1] "SnowballC" "hunspell" "reshape2" "wordcloud" "RColorBrewer"
## [6] "tidytext" "lmtest" "zoo" "sandwich" "colorspace"
## [11] "rstatix" "GGally" "corrplot" "ggpubr" "caret"
## [16] "lattice" "tseries" "forcats" "stringr" "dplyr"
## [21] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [26] "tidyverse" "stats" "graphics" "grDevices" "utils"
## [31] "datasets" "methods" "base"
##
## [[8]]
## [1] "xtable" "SnowballC" "hunspell" "reshape2" "wordcloud"
## [6] "RColorBrewer" "tidytext" "lmtest" "zoo" "sandwich"
## [11] "colorspace" "rstatix" "GGally" "corrplot" "ggpubr"
## [16] "caret" "lattice" "tseries" "forcats" "stringr"
## [21] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [26] "ggplot2" "tidyverse" "stats" "graphics" "grDevices"
## [31] "utils" "datasets" "methods" "base"
##
## [[9]]
## [1] "knitr" "xtable" "SnowballC" "hunspell" "reshape2"
## [6] "wordcloud" "RColorBrewer" "tidytext" "lmtest" "zoo"
## [11] "sandwich" "colorspace" "rstatix" "GGally" "corrplot"
## [16] "ggpubr" "caret" "lattice" "tseries" "forcats"
## [21] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [26] "tibble" "ggplot2" "tidyverse" "stats" "graphics"
## [31] "grDevices" "utils" "datasets" "methods" "base"
##
## [[10]]
## [1] "kableExtra" "knitr" "xtable" "SnowballC" "hunspell"
## [6] "reshape2" "wordcloud" "RColorBrewer" "tidytext" "lmtest"
## [11] "zoo" "sandwich" "colorspace" "rstatix" "GGally"
## [16] "corrplot" "ggpubr" "caret" "lattice" "tseries"
## [21] "forcats" "stringr" "dplyr" "purrr" "readr"
## [26] "tidyr" "tibble" "ggplot2" "tidyverse" "stats"
## [31] "graphics" "grDevices" "utils" "datasets" "methods"
## [36] "base"Первым делом, считается количество вхождений слова в каждый отзыв
superwine <- wine %>%
filter(str_detect(description, "^[^>]+[A-Za-z\\d]") | description !="")
superwine <- tibble(id_review = as.numeric(superwine$...1) , text_review = superwine$description, is_good = superwine$description >= 92)
superwine <- superwine %>% unnest_tokens(word, text_review) %>% na.omit()
superwineДалее была построена гистограмма для топа слов по всем отзывам. Ожидаемо, чаще всего встречаются союзы, предлоги, артикли и прочие служебные части речи. Их осмысленного, понятное дело часто встречается слово wine и характеристики вина - таннинность, кислотность, общее впечатление.
superwine %>%
count(word, sort = TRUE) %>%
filter(n > 20000) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n)) +
geom_col() +
xlab(NULL) +
coord_flip() +
ggtitle("Plot top words count")
Далее все вино было поделено на 2 категории - с оценкой ниже и выше 92. Собственно, хорошим я буду называть вино, оцененнок выше 92 баллов. Оценка взята не с потолка и даже не p-value, а банально из личного опыта. Были построены гистограммы для наиболее частых слов в хорошем и плохом вине. Там много пересечений, большая часть снова служебные части речи и очень хорошо заметно, что отзывы о хорошем вине длиннее. При этом в более низкорейтиговом вине чаще появляются характеристики и описания, а высокорейтинговое оценивают ощущениями
superwine_counts <- superwine %>% group_by( word, is_good) %>%summarise (count = n())## `summarise()` has grouped output by 'word'. You can override using the
## `.groups` argument.superwine_counts %>%
group_by(is_good) %>%
top_n(25, count) %>%
ungroup() %>%
mutate(word = reorder(word, count)) %>%
ggplot(aes(y = word, x = count, fill = is_good)) +
geom_col(show.legend = FALSE) +
facet_wrap(~is_good, scales = "free_y") +
labs(y = "Contribution to Sentiment", x = NULL) +
ggtitle("Plot top words into categories")
Было построено сравнительное облако слов о хорошем и плохом вине. Чем больше на нем слово, тем чаще оно появляется в соответсвующих отзывах
superwine %>%
count(word, is_good, sort = TRUE) %>%
acast(word ~ is_good, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("gray20", "gray80"), max.words = 100)
Далее было отобрано 100 самых часто встречающися слов по категориям хорошего и плохого вина и для этих слов сделан тест фишера (проверялась зависимость переменных наличие слова и статус отзыва - хороший или не очень)
most_freq <- superwine_counts %>%
group_by(is_good) %>%
top_n(100, count) %>%
ungroup()
most_freq <- most_freq %>% distinct(word)
pval_freqs <- c()
for (pattern in most_freq$word){
my_mat <- c(filter(superwine_counts, word==pattern & is_good == T)[1, 'count'],
filter(superwine_counts, word==pattern & is_good == F)[1, 'count'],
sum(filter(superwine_counts, word!=pattern & is_good == T)[, 'count']),
sum(filter(superwine_counts, word!=pattern & is_good == F)[, 'count']))
my_mat <- unlist(my_mat, use.names=FALSE)
my_mat <- matrix(my_mat,nrow=2,ncol=2,byrow=TRUE)
my_mat[is.na(my_mat)] = 0
cur_pva <- fisher.test(my_mat, simulate.p.value = T, B = 10000)$p.value
pval_freqs <- append(pval_freqs, cur_pva)
}Был построен график -log2 p-value (поправленных Холмом). На нем можно увидеть, ккие слова ассоциированы с какой категорией отзывов. В среднем, плохие отзывы более числовые и включают слова-описания вкуса вина, хорошие же об эмоциях и красном вишневом вине.А столбики 2 цветов - это, скорее всего, артефакт, вызванный ну очень уж разными размерами отзывов.
pval_freqs <- p.adjust(pval_freqs, method = "holm")
pval_table <- data.frame(word = most_freq$word, b = -1*log(pval_freqs, base = 2))
pval_table <- as_tibble(pval_table)most_freq <- superwine_counts %>%
group_by(is_good) %>%
top_n(100, count) %>%
ungroup()
pval_table = left_join(pval_table, most_freq, by = c("word" = "word"))pval_table %>%
top_n(50, b) %>%
ggplot(aes(y = word, x = b, fill = is_good)) +
geom_col(show.legend = T) +
labs(y = "", x = NULL) +
ggtitle("-log2 pvalues") +
ggtitle("Plot of top words pvalues")
Та часть, которая не получилась - здесь должна была быть модель предсказатель рейтинга по отзыву на основе реккурентных слоев, но моего компа не хватило даже на токенизацию небольшой подвыборки. Если бы был питон/видеокарта/нормальные мозги запилил бы реккурентную нейронку с кучей параметров (нет. или да. надо будет попробовать на досуге).
Ну вот как-то так. А я пошел проверять на практике предположение о том, что большие отзывы связаны с хорошим вином. И что хорошее вино стоит дорого (плакала моя зарплата(((((. И вам желаю того же - чем больше данных, тем точнее статистика.